home *** CD-ROM | disk | FTP | other *** search
/ PC Open 107 / PC Open 107 CD 1.bin / CD1 / INTERNET / EMAIL / pop file / setup.exe / Proxy / SMTP.pm < prev   
Encoding:
Perl POD Document  |  2004-12-13  |  13.9 KB  |  420 lines
  1. # POPFILE LOADABLE MODULE
  2. package Proxy::SMTP;
  3.  
  4. use Proxy::Proxy;
  5. @ISA = ("Proxy::Proxy");
  6.  
  7. # ----------------------------------------------------------------------------
  8. #
  9. # This module handles proxying the SMTP protocol for POPFile.
  10. #
  11. # Copyright (c) 2001-2004 John Graham-Cumming
  12. #
  13. #   This file is part of POPFile
  14. #
  15. #   POPFile is free software; you can redistribute it and/or modify
  16. #   it under the terms of the GNU General Public License as published by
  17. #   the Free Software Foundation; either version 2 of the License, or
  18. #   (at your option) any later version.
  19. #
  20. #   POPFile is distributed in the hope that it will be useful,
  21. #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  22. #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23. #   GNU General Public License for more details.
  24. #
  25. #   You should have received a copy of the GNU General Public License
  26. #   along with POPFile; if not, write to the Free Software
  27. #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  28. #
  29. # ----------------------------------------------------------------------------
  30.  
  31. use strict;
  32. use warnings;
  33. use locale;
  34.  
  35. # A handy variable containing the value of an EOL for networks
  36. my $eol = "\015\012";
  37.  
  38. #----------------------------------------------------------------------------
  39. # new
  40. #
  41. #   Class new() function
  42. #----------------------------------------------------------------------------
  43. sub new
  44. {
  45.     my $type = shift;
  46.     my $self = Proxy::Proxy->new();
  47.  
  48.     # Must call bless before attempting to call any methods
  49.  
  50.     bless $self, $type;
  51.  
  52.     $self->name( 'smtp' );
  53.  
  54.     $self->{child_} = \&child__;
  55.     $self->{connection_timeout_error_} = '554 Transaction failed';
  56.     $self->{connection_failed_error_}  = '554 Transaction failed, can\'t connect to';
  57.     $self->{good_response_}            = '^[23]';
  58.  
  59.     return $self;
  60. }
  61.  
  62. # ----------------------------------------------------------------------------
  63. #
  64. # initialize
  65. #
  66. # Called to initialize the SMTP proxy module
  67. #
  68. # ----------------------------------------------------------------------------
  69. sub initialize
  70. {
  71.     my ( $self ) = @_;
  72.  
  73.     # By default we don't fork on Windows
  74.     $self->config_( 'force_fork', ($^O eq 'MSWin32')?0:1 );
  75.  
  76.     # Default port for SMTP service
  77.     $self->config_( 'port', 25 );
  78.  
  79.     # Where to forward on to
  80.     $self->config_( 'chain_server', '' );
  81.     $self->config_( 'chain_port', 25 );
  82.  
  83.     # Only accept connections from the local machine for smtp
  84.     $self->config_( 'local', 1 );
  85.  
  86.     # The welcome string from the proxy is configurable
  87.     $self->config_( 'welcome_string', "SMTP POPFile ($self->{version_}) welcome" );
  88.  
  89.     if ( !$self->SUPER::initialize() ) {
  90.         return 0;
  91.     }
  92.  
  93.     $self->config_( 'enabled', 0 );
  94.  
  95.     return 1;
  96. }
  97.  
  98. # ----------------------------------------------------------------------------
  99. #
  100. # start
  101. #
  102. # Called to start the SMTP proxy module
  103. #
  104. # ----------------------------------------------------------------------------
  105. sub start
  106. {
  107.     my ( $self ) = @_;
  108.  
  109.     # If we are not enabled then no further work happens in this module
  110.  
  111.     if ( $self->config_( 'enabled' ) == 0 ) {
  112.         return 2;
  113.     }
  114.  
  115.     # Tell the user interface module that we having a configuration
  116.     # item that needs a UI component
  117.  
  118.     $self->register_configuration_item_( 'configuration',
  119.                                          'smtp_fork_and_port',
  120.                                          'smtp-configuration.thtml',
  121.                                          $self );
  122.  
  123.     $self->register_configuration_item_( 'security',
  124.                                          'smtp_local',
  125.                                          'smtp-security-local.thtml',
  126.                                          $self );
  127.  
  128.     $self->register_configuration_item_( 'chain',
  129.                                          'smtp_server',
  130.                                          'smtp-chain-server.thtml',
  131.                                          $self );
  132.  
  133.     $self->register_configuration_item_( 'chain',
  134.                                          'smtp_server_port',
  135.                                          'smtp-chain-server-port.thtml',
  136.                                          $self );
  137.  
  138.     if ( $self->config_( 'welcome_string' ) =~ /^SMTP POPFile \(v\d+\.\d+\.\d+\) welcome$/ ) { # PROFILE BLOCK START
  139.         $self->config_( 'welcome_string', "SMTP POPFile ($self->{version_}) welcome" );        # PROFILE BLOCK STOP
  140.     }
  141.  
  142.     return $self->SUPER::start();;
  143. }
  144.  
  145. # ----------------------------------------------------------------------------
  146. #
  147. # child__
  148. #
  149. # The worker method that is called when we get a good connection from a client
  150. #
  151. # $client   - an open stream to a SMTP client
  152. # $session        - API session key
  153. #
  154. # ----------------------------------------------------------------------------
  155. sub child__
  156. {
  157.     my ( $self, $client, $session ) = @_;
  158.  
  159.     # Number of messages downloaded in this session
  160.     my $count = 0;
  161.  
  162.     # The handle to the real mail server gets stored here
  163.     my $mail;
  164.  
  165.     # Tell the client that we are ready for commands and identify our version number
  166.     $self->tee_( $client, "220 " . $self->config_( 'welcome_string' ) . "$eol" );
  167.  
  168.     # Retrieve commands from the client and process them until the client disconnects or
  169.     # we get a specific QUIT command
  170.     while  ( <$client> ) {
  171.         my $command;
  172.  
  173.         $command = $_;
  174.  
  175.         # Clean up the command so that it has a nice clean $eol at the end
  176.         $command =~ s/(\015|\012)//g;
  177.  
  178.         $self->log_( 2, "Command: --$command--" );
  179.  
  180.         if ( $command =~ /HELO/i ) {
  181.             if ( $self->config_( 'chain_server' ) )  {
  182.                 if ( $mail = $self->verify_connected_( $mail, $client, $self->config_( 'chain_server' ),  $self->config_( 'chain_port' ) ) )  {
  183.  
  184.                     $self->smtp_echo_response_( $mail, $client, $command );
  185.                 } else {
  186.                     last;
  187.                 }
  188.             } else {
  189.                 $self->tee_(  $client, "421 service not available$eol" );
  190.             }
  191.  
  192.             next;
  193.         }
  194.  
  195.         # Handle EHLO specially so we can control what ESMTP extensions are negotiated
  196.  
  197.         if ( $command =~ /EHLO/i ) {
  198.             if ( $self->config_( 'chain_server' ) )  {
  199.                 if ( $mail = $self->verify_connected_( $mail, $client, $self->config_( 'chain_server' ),  $self->config_( 'chain_port' ) ) )  {
  200.  
  201.                     # TODO: Make this user-configurable (-smtp_add_unsupported, -smtp_remove_unsupported)
  202.  
  203.                     # Stores a list of unsupported ESMTP extensions
  204.  
  205.                     my $unsupported;
  206.  
  207.                     # RFC 1830, http://www.faqs.org/rfcs/rfc1830.html
  208.                     # CHUNKING and BINARYMIME both require the support of the "BDAT" command
  209.                     # support of BDAT requires extensive changes to POPFile's internals and
  210.                     # will not be implemented at this time
  211.  
  212.                     $unsupported .= "CHUNKING|BINARYMIME|XEXCH50";
  213.  
  214.                     # append unsupported ESMTP extensions to $unsupported here, important to maintain
  215.                     # format of OPTION|OPTION2|OPTION3
  216.  
  217.                     $unsupported = qr/250\-$unsupported/;
  218.  
  219.                     $self->smtp_echo_response_( $mail, $client, $command, $unsupported );
  220.  
  221.  
  222.                 } else {
  223.                     last;
  224.                 }
  225.             } else {
  226.                 $self->tee_(  $client, "421 service not available$eol" );
  227.             }
  228.  
  229.             next;
  230.         }
  231.  
  232.         if ( ( $command =~ /MAIL FROM:/i )    ||
  233.              ( $command =~ /RCPT TO:/i )      ||
  234.              ( $command =~ /VRFY/i )          ||
  235.              ( $command =~ /EXPN/i )          ||
  236.              ( $command =~ /NOOP/i )          ||
  237.              ( $command =~ /HELP/i )          ||
  238.              ( $command =~ /RSET/i ) ) {
  239.             $self->smtp_echo_response_( $mail, $client, $command );
  240.             next;
  241.         }
  242.  
  243.         if ( $command =~ /DATA/i ) {
  244.             # Get the message from the remote server, if there's an error then we're done, but if not then
  245.             # we echo each line of the message until we hit the . at the end
  246.             if ( $self->smtp_echo_response_( $mail, $client, $command ) ) {
  247.                 $count += 1;
  248.  
  249.                 my ( $class, $history_file ) = $self->{classifier__}->classify_and_modify( $session, $client, $mail, 0, '', 0  );
  250.  
  251.                 my $response = $self->slurp_( $mail );
  252.                 $self->tee_( $client, $response );
  253.                 next;
  254.             }
  255.         }
  256.  
  257.         # The mail client wants to stop using the server, so send that message through to the
  258.         # real mail server, echo the response back up to the client and exit the while.  We will
  259.         # close the connection immediately
  260.         if ( $command =~ /QUIT/i ) {
  261.             if ( $mail )  {
  262.                 $self->smtp_echo_response_( $mail, $client, $command );
  263.                 close $mail;
  264.             } else {
  265.                 $self->tee_(  $client, "221 goodbye$eol" );
  266.             }
  267.             last;
  268.         }
  269.  
  270.         # Don't know what this is so let's just pass it through and hope for the best
  271.         if ( $mail && $mail->connected )  {
  272.             $self->smtp_echo_response_( $mail, $client, $command );
  273.             next;
  274.         } else {
  275.             $self->tee_(  $client, "500 unknown command or bad syntax$eol" );
  276.             last;
  277.         }
  278.     }
  279.  
  280.     if ( defined( $mail ) ) {
  281.         $self->done_slurp_( $mail );
  282.         close $mail;
  283.     }
  284.  
  285.     close $client;
  286.     $self->mq_post_( 'CMPLT', $$ );
  287.     $self->log_( 0, "SMTP proxy done" );
  288. }
  289.  
  290. # ----------------------------------------------------------------------------
  291. #
  292. # smtp_echo_response_
  293. #
  294. # $mail     The stream (created with IO::) to send the message to (the remote mail server)
  295. # $client   The local mail client (created with IO::) that needs the response
  296. # $command  The text of the command to send (we add an EOL)
  297. # $suppress (OPTIONAL) suppress any lines that match, compile using qr/pattern/
  298. #
  299. # Send $command to $mail, receives the response and echoes it to the $client and the debug
  300. # output.
  301. #
  302. # This subroutine returns responses from the server as defined in appendix E of
  303. # RFC 821, allowing multi-line SMTP responses.
  304. #
  305. # Returns true if the initial response is a 2xx or 3xx series (as defined by {good_response_}
  306. #
  307. # ----------------------------------------------------------------------------
  308. sub smtp_echo_response_
  309. {
  310.     my ($self, $mail, $client, $command, $suppress) = @_;
  311.     my ( $response, $ok ) = $self->get_response_( $mail, $client, $command );
  312.  
  313.     if ( $response =~ /^\d\d\d-/ ) {
  314.         $self->echo_to_regexp_($mail, $client, qr/^\d\d\d /, 1, $suppress);
  315.     }
  316.     return ( $response =~ /$self->{good_response_}/ );
  317. }
  318.  
  319. # ----------------------------------------------------------------------------
  320. #
  321. # configure_item
  322. #
  323. #    $name            Name of this item
  324. #    $templ           The loaded template that was passed as a parameter
  325. #                     when registering
  326. #    $language        Current language
  327. #
  328. # ----------------------------------------------------------------------------
  329.  
  330. sub configure_item
  331. {
  332.     my ( $self, $name, $templ, $language ) = @_;
  333.  
  334.     if ( $name eq 'smtp_fork_and_port' ) {
  335.         $templ->param( 'smtp_port' => $self->config_( 'port' ) );
  336.         $templ->param( 'smtp_force_fork_on' => $self->config_( 'force_fork' ) );
  337.     }
  338.  
  339.     if ( $name eq 'smtp_local' ) {
  340.         $templ->param( 'smtp_local_on' => $self->config_( 'local' ) );
  341.      }
  342.  
  343.     if ( $name eq 'smtp_server' ) {
  344.         $templ->param( 'smtp_chain_server' => $self->config_( 'chain_server' ) );
  345.     }
  346.  
  347.     if ( $name eq 'smtp_server_port' ) {
  348.         $templ->param( 'smtp_chain_port' => $self->config_( 'chain_port' ) );
  349.     }
  350.  
  351.  
  352.     #$self->SUPER::configure_item( $name, $templ, $language );
  353. }
  354.  
  355. # ----------------------------------------------------------------------------
  356. #
  357. # validate_item
  358. #
  359. #    $name            The name of the item being configured, was passed in by the call
  360. #                     to register_configuration_item
  361. #    $templ           The loaded template
  362. #    $language        The language currently in use
  363. #    $form            Hash containing all form items
  364. #
  365. # ----------------------------------------------------------------------------
  366.  
  367. sub validate_item
  368. {
  369.     my ( $self, $name, $templ, $language, $form ) = @_;
  370.  
  371.     if ( $name eq 'smtp_fork_and_port' ) {
  372.  
  373.         if ( defined($$form{smtp_force_fork}) ) {
  374.             $self->config_( 'force_fork', $$form{smtp_force_fork} );
  375.         }
  376.  
  377.         if ( defined($$form{smtp_port}) ) {
  378.             if ( ( $$form{smtp_port} >= 1 ) && ( $$form{smtp_port} < 65536 ) ) {
  379.                 $self->config_( 'port', $$form{smtp_port} );
  380.                 $templ->param( 'smtp_port_feedback' => sprintf( $$language{Configuration_SMTPUpdate}, $self->config_( 'port' ) ) );
  381.              } else {
  382.                 $templ->param( 'smtp_port_feedback' => "<div class=\"error01\">$$language{Configuration_Error3}</div>" );
  383.              }
  384.         }
  385.     }
  386.  
  387.     if ( $name eq 'smtp_local' ) {
  388.         if ( defined $$form{smtp_local} ) {
  389.             $self->config_( 'local', $$form{smtp_local} );
  390.         }
  391.     }
  392.  
  393.     if ( $name eq 'smtp_server' ) {
  394.         if ( defined $$form{smtp_chain_server} ) {
  395.             $self->config_( 'chain_server', $$form{smtp_chain_server} );
  396.             $templ->param( 'smtp_server_feedback' => sprintf $$language{Security_SMTPServerUpdate}, $self->config_( 'chain_server' ) ) ;
  397.         }
  398.     }
  399.  
  400.     if ( $name eq 'smtp_server_port' ) {
  401.         if ( defined $$form{smtp_chain_server_port} ) {
  402.  
  403.             if ( ( $$form{smtp_chain_server_port} >= 1 ) && ( $$form{smtp_chain_server_port} < 65536 ) ) {
  404.                 $self->config_( 'chain_port', $$form{smtp_chain_server_port} );
  405.                 $templ->param( 'smtp_port_feedback' => sprintf $$language{Security_SMTPPortUpdate}, $self->config_( 'chain_port' ) );
  406.             }
  407.             else {
  408.                 $templ->param( 'smtp_port_feedback' => "<div class=\"error01\">$$language{Security_Error1}</div>" );
  409.             }
  410.         }
  411.     }
  412.  
  413.  
  414.     #$self->SUPER::validate_item( $name, $templ, $language, $form );
  415. }
  416.  
  417. 1;
  418.  
  419.  
  420.